home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tex / textyl / textyl.shar5.Z / textyl.shar5
Encoding:
Text File  |  1987-08-10  |  54.7 KB  |  2,090 lines
  1. #!/bin/sh
  2. # to extract, remove the header and type "sh filename"
  3. if `test ! -d ./src`
  4. then
  5.   mkdir ./src
  6.   echo "mkdir ./src"
  7. fi
  8. if `test ! -s ./src/makefile`
  9. then
  10. echo "writing ./src/makefile"
  11. cat > ./src/makefile << 'E_O_F'
  12. #  Makefile for TeXtyl
  13. #    Tue May 26 1987    John S. Renner
  14. #  be sure to edit texpaths.h to reflect local directory conventions
  15. #    before compiling
  16. textyl: textyl.pas tylext.o tylext.h
  17.     /lib/cpp -P  textyl.pas textyl.p
  18.     pc -w  -c  textyl.p
  19.     rm -f textyl.p
  20.     pc  -o textyl textyl.o tylext.o
  21.  
  22. SRCS = textyl.pas.aa textyl.pas.ab textyl.pas.ac \
  23.     textyl.pas.ad textyl.pas.ae textyl.pas.af \
  24.     textyl.pas.ag textyl.pas.ah
  25.  
  26. textyl.pas: $(SRCS)
  27.     cat $(SRCS) > textyl.pas
  28.  
  29. tylext.o: tylext.c texpaths.h h00vars.h
  30.     cc -c tylext.c
  31.  
  32. clean:
  33.     /bin/rm  -f  *.o textyl.p
  34.  
  35. E_O_F
  36. else
  37.   echo "will not over write ./src/makefile"
  38. fi
  39. chmod 644 ./src/makefile
  40. if [ `wc -c ./src/makefile | awk '{printf $1}'` -ne 557 ]
  41. then
  42. echo `wc -c ./src/makefile | awk '{print "Got " $1 ", Expected " 557}'`
  43. fi
  44. if `test ! -s ./src/tylext.h`
  45. then
  46. echo "writing ./src/tylext.h"
  47. cat > ./src/tylext.h << 'E_O_F'
  48. procedure setpaths;
  49.     external;
  50.  
  51. function testaccess(accessmode:integer; filepath:integer): boolean;
  52.     external;
  53. E_O_F
  54. else
  55.   echo "will not over write ./src/tylext.h"
  56. fi
  57. chmod 644 ./src/tylext.h
  58. if [ `wc -c ./src/tylext.h | awk '{printf $1}'` -ne 117 ]
  59. then
  60. echo `wc -c ./src/tylext.h | awk '{print "Got " $1 ", Expected " 117}'`
  61. fi
  62. if `test ! -s ./src/textyl.pas.ag`
  63. then
  64. echo "writing ./src/textyl.pas.ag"
  65. cat > ./src/textyl.pas.ag << 'E_O_F'
  66. procedure tylBrokenLine (x0, y0, x1, y1, fontindex : integer;
  67.              line_type: LineStyle);
  68. label 10;
  69. var useXaxis: boolean;
  70.     a0, b0, a1, b1: integer;
  71.     a2, a3, b2, b3, K, gap, dot, dash: integer; 
  72.     s, z, fit: real;
  73.     J, frame, T: integer;
  74.     Dotgap, Dotdot:  integer;
  75.     Dashgap, Dashdash: integer;
  76.     DDotgap, DDotdot, DDotdash: integer;    
  77.     a1ma0 : integer;
  78.     
  79. {.........................................................}
  80.    procedure spread (lt : LineStyle; extra, T : integer);
  81.       label 20;
  82.       begin
  83.       if (T = 0) then
  84.          begin  { only partial frame fits }
  85.          if (useXaxis) then 
  86.        diagonal (a0, b0, a1, b1, fontindex)
  87.          else 
  88.        diagonal (b0, a0, b1, a1, fontindex);
  89.          goto 20;  { exit }
  90.          end;
  91.       J := 0;
  92.       s := float (b1 - b0)/float(a1 - a0);
  93.       z := float (extra)/float(T);
  94.       case lt of
  95.          dotted : repeat a2 := a0 + J*frame;
  96.                          if (extra > 0) then a2 := a2 + round(J*z);
  97.                          a3 := a2 + dot;
  98.                          b2 := round(s*(a2-a0) + b0);
  99.                          b3 := round(s*(a3-a0) + b0);
  100.                          if (a3 <= a1) then
  101.                             begin
  102.                             if (useXaxis) then
  103.                   diagonal (a2, b2, a3, b3, fontindex)
  104.                             else  
  105.                   diagonal (b2, a2, b3, a3, fontindex);
  106.                             end;
  107.                          J := J + 1;
  108.                      until (a3 >= a1);
  109.          dashed : repeat a2 := a0 + J*frame;
  110.                          if (extra > 0) then a2 := a2 + round(J*z);
  111.                          a3 := a2 + dash;
  112.                          b2 := round(s*(a2-a0) + b0);
  113.                          b3 := round(s*(a3-a0) + b0);
  114.                          if (a3 <= a1) then
  115.                            begin
  116.                            if (useXaxis) then
  117.                  diagonal (a2, b2, a3, b3, fontindex)
  118.                            else
  119.                  diagonal (b2, a2, b3, a3, fontindex);
  120.                            end;
  121.                          J := J + 1;
  122.                      until (a3 >= a1);
  123.         dotdash : repeat a2 := a0 + J*frame;
  124.                          if (extra > 0) then a2 := a2 + round(J*z);
  125.                          a3 := a2 + dash;
  126.                          b2 := round(s*(a2-a0) + b0);
  127.                          b3 := round(s*(a3-a0) + b0);
  128.                          if (a3 <= a1) then
  129.                             begin
  130.                             if (useXaxis) then
  131.                   diagonal (a2, b2, a3, b3, fontindex)
  132.                             else
  133.                   diagonal (b2, a2, b3, a3, fontindex);
  134.                             a2 := a3 + gap;
  135.                             if (extra > 0) then a2 := a2 + round(z*0.5);
  136.                             a3 := a2 + dot;
  137.                             b2 := round(s*(a2-a0) + b0);
  138.                             b3 := round(s*(a3-a0) + b0);
  139.                             if (a3 <= a1) then
  140.                                begin
  141.                                if (useXaxis) then
  142.                      diagonal (a2, b2, a3, b3, fontindex)
  143.                                else
  144.                      diagonal (b2, a2, b3, a3, fontindex);
  145.                                end;
  146.                             end;
  147.                          J := J + 1;
  148.                      until (a3 >= a1);
  149.          end;
  150.      20:
  151.       end;   { spread }
  152.       
  153. {......................................................}               
  154.    procedure balance (lt : LineStyle; extra, T : integer);
  155.       label 30;
  156.       begin
  157.       if (T = 0) then
  158.          begin  { only partial frame fits }
  159.          if (useXaxis) then
  160.         diagonal (a0, b0, a1, b1, fontindex)
  161.          else
  162.         diagonal (b0, a0, b1, a1, fontindex);
  163.          goto 30; { exit }
  164.          end;
  165.       J := 0;
  166.       s := float(b1 - b0)/float(a1 - a0);
  167.       case lt of
  168.          dashed : repeat a2 := a0 + J*frame - extra div 2;
  169.                          a3 := a2 + dash;
  170.                          if (J = 0) then a2 := a0;
  171.                          if (a3 > a1) then a3 := a1;
  172.                          b2 := round(s*(a2-a0) + b0);
  173.                          b3 := round(s*(a3-a0) + b0);
  174.                          if (a3 <= a1) then
  175.                            begin
  176.                            if (useXaxis) then
  177.                  diagonal (a2, b2, a3, b3, fontindex)
  178.                            else
  179.                  diagonal (b2, a2, b3, a3, fontindex);
  180.                            end;
  181.                          J := J + 1;
  182.                      until (a3 >= a1);
  183.         dotdash : repeat a2 := a0 + J*frame - extra div 2;
  184.                          a3 := a2 + dash;
  185.                          if (J = 0) then a2 := a0;
  186.                          if (a3 > a1) then a3 := a1;
  187.                          b2 := round(s*(a2-a0) + b0);
  188.                          b3 := round(s*(a3-a0) + b0);
  189.                          if (a3 <= a1) then
  190.                             begin
  191.                             if (useXaxis) then
  192.                   diagonal (a2, b2, a3, b3, fontindex)
  193.                             else 
  194.                   diagonal (b2, a2, b3, a3, fontindex);
  195.                             a2 := a3 + gap;
  196.                             a3 := a2 + dot;
  197.                             b2 := round(s*(a2-a0) + b0);
  198.                             b3 := round(s*(a3-a0) + b0);
  199.                             if (a3 <= a1) then
  200.                                begin
  201.                                if (useXaxis) then
  202.                      diagonal (a2, b2, a3, b3, fontindex)
  203.                                else
  204.                      diagonal (b2, a2, b3, a3, fontindex);
  205.                                end;
  206.                             end;
  207.                          J := J + 1;
  208.                      until (a3 >= a1);
  209.          end;
  210.      30:
  211.       end;  { balance }
  212.       
  213. {......................................................}   
  214.   function project (I : integer) : integer;
  215.     var K : integer;        { gives the projection of lengths onto axes }
  216.     begin
  217.     K := round(I*float(abs(a1-a0))/s);
  218.     if K = 0 then K := 1;
  219.     project := K;
  220.     end;
  221. {......................................................}
  222.   procedure setlengths (findex :integer);
  223.         (*  sets the "optimal" sizes for textured lines *)
  224.     var penrad : integer;
  225.         siz : VThickness;
  226.     begin
  227.     penrad := VFontTable[findex]^.PenSize;
  228.     siz := VFontTable[findex]^.psize;
  229.  
  230.     Dotdot  :=  penrad div siz;   Dotgap := 6 * penrad;
  231.     Dashdash := 6 * penrad;  Dashgap := 6 * penrad;
  232.     DDotdash := 6 * penrad;  DDotgap := 4 * penrad; 
  233.     DDotdot :=  penrad div siz;
  234.     end;
  235. {........................................}
  236. procedure setframesize;
  237. begin
  238.  case line_type of        { length of frame depends on type of broken line }
  239.     solid   : frame := 0;
  240.     dotted  : frame := gap + dot;
  241.     dashed  : frame := gap + dash;
  242.     dotdash : frame := 2*gap + dot + dash;
  243.     end;
  244. end;
  245.  
  246. {.................................................}         
  247. begin  (*  TylBrokenLine *)
  248. if ((x0 = x1) and (y0 = y1)) then
  249.   begin
  250.   diagonal (x0, y0, x1, y1, fontindex); { null line }
  251.   goto 10;
  252.   end;
  253.  
  254.   setlengths (fontindex);
  255.  
  256. if (abs (y1-y0) > abs(x1-x0)) then    { longer axis is used as base }
  257.   begin
  258.   useXaxis := false;
  259.   a0 := y0;  b0 := x0;
  260.   a1 := y1;  b1 := x1;
  261.   end
  262. else
  263.   begin
  264.   useXaxis := true;
  265.   a0 := x0;  b0 := y0;
  266.   a1 := x1;  b1 := y1;
  267.   end;
  268. { the distance between a0 and a1 is now greater than that between b0 and b1. }
  269.  
  270. { redefine distances as integral units along axes }
  271.  s := distance (float(a0),float(b0),float(a1),float(b1));
  272.  
  273.  case line_type of
  274.    solid: ;
  275.    dotted:
  276.      begin
  277.      gap := project(Dotgap);
  278.      dot := project(Dotdot);
  279.      end;
  280.    dashed:
  281.      begin
  282.      gap := project(Dashgap);
  283.      dash := project(Dashdash);
  284.      end;
  285.    dotdash:
  286.      begin
  287.      gap := project(DDotgap);
  288.      dot := project(DDotdot);
  289.      dash := project(DDotdash);
  290.      end;
  291.    end;
  292.  
  293.              { ensure direction of line is from smaller to
  294.                larger along the longer axis }
  295.  if (a0 > a1) then     
  296.     begin
  297.     J := a0; a0 := a1; a1 := J;
  298.     J := b0; b0 := b1; b1 := J;
  299.     end;
  300.     
  301.  setframesize; 
  302.  
  303.  a1ma0 := a1 - a0;
  304.  
  305.     { fit is the number of frames that fit in line }
  306.  if (frame <> 0) then
  307.    begin
  308.    fit := (float(a1ma0) / float(frame));
  309.    end
  310.  else
  311.    fit := 1.0;
  312.  
  313.  if (fit >= 1.0) then
  314.    T := round (fit)
  315.  else
  316.    begin
  317.   (* change frame elements (dot, dash, gap) since frame is too large *)
  318.      case line_type of
  319.        dotted : begin
  320.                gap := gap - (frame - a1ma0);
  321.         if (gap < dot) then 
  322.           begin
  323.           goto 10; (* exit *)
  324.           end;
  325.         setframesize;
  326.         end;
  327.  
  328.     dashed,
  329.     dotdash : begin
  330.     (* idea:decrease gap; if too small then shrink dash and refigure gap*)
  331.          if ((frame - a1ma0) > (gap div 2)) then
  332.            begin
  333.            dash := round (dash * fit * 0.80);
  334.            gap := round (gap * fit);
  335.            setframesize;
  336.            end;
  337.          gap := gap - (frame - a1ma0);
  338.          if (line_type = dotdash) then
  339.            gap := gap div 2;
  340.          if (gap < dot) then 
  341.            begin
  342.            goto 10; (* exit *)
  343.            end;
  344.          setframesize;
  345.          end;
  346.     end; (* case *)
  347.      T := 1; (* NOW it will fit *)
  348.    end;  (* else *)
  349.  
  350.  
  351.  case line_type of
  352.     solid : begin
  353.           if (useXaxis) then
  354.             diagonal (a0, b0, a1, b1, fontindex)
  355.           else 
  356.                 diagonal (b0, a0, b1, a1, fontindex);
  357.         end;
  358.  
  359.     dotted : begin         { dotted lines begin and end on a dot }
  360.          if ((T*frame + dot) = a1ma0) then
  361.         spread(dotted, 0, T) 
  362.          else if ((T*frame + dot) > a1ma0) then
  363.              begin
  364. {        gap := gap - ((T*frame+dot)-a1ma0);
  365. {}
  366.             spread(dotted, a1ma0 - T*frame - dot, T);
  367.  
  368. {              spread(dotted, a1ma0 - (T-1)*frame - dot, T-1);
  369. {}
  370.         end
  371.          else 
  372.            spread(dotted, a1ma0 - T*frame - dot, T);
  373.          end;
  374.  
  375.     dashed : begin
  376.                { dashed lines begin and end on dash :
  377.             the beginning and ending dashes are at least half
  378.             the dash length long. }
  379.           if ((T*frame + dash) = a1ma0) then 
  380.         spread(dashed, 0, T)
  381.          else if ((T*frame + dash) > a1ma0) then
  382.         balance(dashed, T*frame + dash - a1ma0, T)
  383.          else spread(dashed, a1ma0 - T*frame - dash, T);
  384.          end;
  385.  
  386.     dotdash : begin        { if ending on a dash then beginning and ending
  387.             dashes are half the dash length long - final
  388.             dots are full dot length }
  389.           if ((T*frame + dash) = a1ma0) then
  390.          spread(dotdash, 0, T)
  391.           else if ((T*frame + dash + gap + dot) = a1ma0) then
  392.          spread(dotdash, 0, T)
  393.           else if ((T*frame + dash) > a1ma0) then
  394.          balance(dotdash, T*frame + dash - a1ma0, T)
  395.           else if ((T*frame + dash + gap + dot) > a1ma0) then
  396.          spread(dotdash, a1ma0 - T*frame - dash, T)
  397.           else spread(dotdash, a1ma0 - T*frame - dash - gap - dot, T);
  398.           end;
  399.     end;
  400. 10:
  401.  end;
  402.  
  403.     
  404.  
  405. {-------------------------------------------------------}
  406. procedure clampthickness (var thic : VThickness);
  407.   begin
  408.   (* #### this is just a simple clamp
  409.     really should be something like:
  410.     while not (thic in set_of_appropriate_thicknesses) do
  411.       modify thic and try again
  412.   *)
  413.   if (thic <= LoVThick ) then
  414.     thic := LoVThick + 1;
  415.   while ((not (thic in [1,2,3,4,5,6,7,8,9,10,11,12])) and
  416.       (thic <= HiVThick)) do
  417.     thic := thic + 1;
  418.   
  419.   if (thic >  HiVThick) then
  420.     thic := HiVThick;
  421.   end;
  422.   
  423. {----------------------------------------------------------}
  424. procedure slurclamp (var thic : ThickAryType; totpts : integer);
  425.   (* this post-clamps the sampled thicknesses calculated over the
  426.   whole of the spline *)
  427.   
  428.   var i : integer;
  429.    oneseventh : integer;
  430.    middle : integer;
  431.    startval, endval: integer;
  432.    deltaval, val, incrval, alpha, alphaincr: real;
  433.    
  434.   begin 
  435.   { $$ NOTE:: How does the ttspline interpolation of thicknesses
  436.   compare to the below results?? Can we avoid having it done
  437.   elsewhere and concentrate on it here?? }
  438.   
  439.   oneseventh := round (totpts / 7.0);
  440.   for i := 1 to oneseventh do
  441.     begin
  442.     thic[i] := thic[1];
  443.     end;
  444.   for i := 6*oneseventh to totpts do
  445.     begin
  446.     thic[i] := thic[totpts];
  447.     end;  
  448.   
  449.   middle := round (totpts / 2.0);
  450.   for i := 3*oneseventh to 4*oneseventh do
  451.     begin
  452.     thic[i] := thic[middle];
  453.     end;
  454.   
  455.   startval := thic[oneseventh - 1];
  456.   endval := thic[3*oneseventh + 1];
  457.   deltaval := (2*(endval - startval))/(2*oneseventh);
  458.   alphaincr := PI / (2 * oneseventh + 1);
  459.   alpha := PI;
  460.   val := float(startval);
  461.   for i := oneseventh to (3*oneseventh - 1) do
  462.     begin     (* interpolate: ease in from minthick to middlethickness *)
  463.     alpha := alpha + alphaincr;
  464.     incrval := ((cos (alpha) + 1.0) / 2.0) * deltaval;
  465.     val := val + incrval;
  466.     thic[i] := round(val);
  467.     end;
  468.   
  469.   startval := thic[4*oneseventh - 1];
  470.   endval := thic[6*oneseventh + 1];
  471.   deltaval := (2*(endval - startval))/(2*oneseventh);
  472.   alphaincr := PI / (2 * oneseventh + 1);
  473.   alpha := 0.0;
  474.   val := float(startval);
  475.   for i := (4*oneseventh + 1) to 6*oneseventh do
  476.     begin  (* ease out from middle thickness to min thick at far end *)
  477.     alpha := alpha + alphaincr;
  478.     incrval := ((cos (alpha) + 1.0) / 2.0) * deltaval;
  479.     val := val + incrval;
  480.     thic[i] := round(val);
  481.     end;
  482.   end;
  483.   
  484. {-------------------------------------------------------}
  485. procedure layline (xl, yb, xr, yt, fontindex : integer; 
  486.            pattern : LineStyle; useVecfontOnly : boolean);
  487.   var t: integer;  
  488.   begin
  489.   if (xr < xl) then
  490.     begin
  491.     t := xr; xr := xl; xl := t;
  492.     t := yb; yb := yt; yt := t;
  493.     end;
  494.   
  495.   isetfont (VFontTable[fontindex]^.DVIFontNum);
  496.   
  497.   (* we may want to require using a vector font only,
  498.   instead of a combination of vectors and TeX-rules.
  499.   It may look better this way.
  500.   *)  
  501.     if (useVecfontOnly) then
  502.        begin
  503.        tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
  504.        end
  505.     else
  506.       begin (* be smart about the lines *)
  507.       if ((xl = xr) and (yb = yt)) or
  508.       ((xl <> xr) and (yb <> yt)) then    (* Null or diagonal lines *)
  509.       begin
  510.       if (pattern = solid) then
  511.           diagonal (xl, yb, xr, yt, fontindex)
  512.       else
  513.         tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
  514.       end
  515.       else
  516.          begin
  517. {     if (pattern = solid) then
  518.        hvline (xl, yb, xr, yt, fontindex) (* make use of rules *)
  519.      else
  520. USENORULES }
  521.        tylBrokenLine (xl, yb, xr, yt, fontindex, pattern);
  522.      end
  523.       end;
  524.     
  525.   end;
  526.   
  527.   
  528.   
  529. {------------------------------------------------------}
  530. procedure layAspline (thetype : SplineKind; 
  531.               isclosed : boolean;
  532.               isanArc: boolean;
  533.               domarks : integer;
  534.               var cpts : ControlPoints;
  535.               numpts : integer;
  536.               thick: VThickness;
  537.               vkind : VectKind;
  538.               patt : LineStyle);
  539.   const DontDoThicks = false;
  540.     VectorsOnly = true;
  541.   var pointList: SplineSegments;
  542.     i, xs, ys : integer;
  543.     tt1, tt2 : ThickAryType;
  544.     F: VecIndex;
  545.   begin
  546.   
  547.   clampthickness (thick);  
  548.   for i := 0 to (numpts + 3) do
  549.     tt1[i] := thick;
  550.   
  551.   (*  do any marks if necessary to show the control points *)
  552.   if (domarks > 0) then
  553.     begin
  554.     F := GetVectFont (domarks, VKCirc);
  555.     isetfont (VFontTable[F]^.DVIFontNum);
  556.     for i := 1 to numpts do
  557.       begin
  558.       Tyldot (cpts[i,1], cpts[i,2]);
  559.       end;  
  560.     end;  
  561.   
  562.   drawSpline (thetype, isclosed, isanArc, patt,
  563.          numpts, cpts, pointList, DontDoThicks, tt1, tt2);
  564.   
  565.   
  566.   F := GetVectFont (thick, vkind);
  567.   xs := pointList[1, 1];
  568.   ys := pointList[1, 2];
  569.   
  570.   for i := 2 to lastPoint do
  571.     begin
  572.     layline (xs, ys, pointList[i, 1], pointList[i, 2], F, patt, VectorsOnly);
  573.     xs := pointList[i, 1];
  574.     ys := pointList[i, 2];
  575.     end;
  576.   if (isclosed) then (* complete the motion *)
  577.     layline (pointList[lastPoint,1], pointList[lastPoint,2],
  578.          pointList[1,1], pointList[1,2], F, patt, VectorsOnly);
  579.   end;
  580.   
  581.  
  582. {-----------------------------------------------------}
  583. procedure layNspline (thetype : SplineKind; 
  584.             isclosed : boolean;
  585.             isitaslur : boolean; 
  586.             domarks : integer;
  587.             var cpts : ControlPoints;
  588.             numpts : integer;
  589.             var thickmatrix : ThickAryType;
  590.             vkind : VectKind;
  591.             patt : LineStyle);
  592.   const NotAnArc = false;
  593.     DoThicksToo = true;
  594.     VectorsOnly = true;
  595.   var pointList: SplineSegments;
  596.     i, xs, ys : integer;
  597.     ts : VThickness;
  598.     tt : ThickAryType;
  599.     F : VecIndex;
  600.   begin
  601.   (*  do any marks if necessary to show the control points *)
  602.   if (domarks > 0) then
  603.     begin
  604.     F := GetVectFont (domarks, VKCirc);
  605.     isetfont (VFontTable[F]^.DVIFontNum);
  606.     for i := 1 to numpts do
  607.       begin
  608.       Tyldot (cpts[i,1], cpts[i,2]);
  609.       end;  
  610.     end;  
  611.   
  612.   drawSpline (thetype, isclosed, NotAnArc, patt,
  613.         numpts, cpts, pointList,
  614.         DoThicksToo, thickmatrix, tt);
  615.   if ((isitaslur) and (not skiptsclamp))  then
  616.     begin
  617.     slurclamp(tt, lastPoint);  (* which kind of clamping to use *)
  618.     end;
  619.   
  620.   xs := pointList[1, 1];
  621.   ys := pointList[1, 2];
  622.   ts := tt[1];
  623.   
  624.   for i := 2 to lastPoint do
  625.     begin
  626.     clampthickness (ts);
  627.     F := GetVectFont (ts, vkind);
  628.     layline (xs, ys, pointList[i, 1], pointList[i, 2], F, patt, VectorsOnly);
  629.     xs := pointList[i, 1];
  630.     ys := pointList[i, 2];
  631.     ts := tt[i];
  632.     end;
  633.   if (isclosed) then
  634.     begin
  635.     ts := tt[lastPoint];
  636.     clampthickness(ts);
  637.     F := GetVectFont (ts, vkind);
  638.     layline (pointList[lastPoint,1], pointList[lastPoint,2],
  639.          pointList[1,1], pointList[1,2], F, patt, VectorsOnly);
  640.     end;
  641.   end;
  642.   
  643.   
  644.   
  645. {-----------------------------------------------------}    
  646. procedure TylBeam (* fromx, fromy, tox, toy: ScaledPts;
  647.            staffsize : integer; kind : BeamKind *); 
  648.  
  649.   begin
  650.  
  651.   end; (* TylBeam *)
  652.   
  653.   
  654. {-------------------------------------------------------}
  655. procedure TylLine (* xl, yb, xr, yt: ScaledPoints;
  656.             thickness: VThickness;
  657.             vec: VectKind; patt : LineStyle *);
  658.   const dontCare = false;
  659.   var findex: VecIndex;
  660.   begin
  661.   clampthickness (thickness);
  662.   findex := GetVectFont (thickness, vec);
  663.   layline (xl, yb, xr, yt, findex, patt, dontCare);
  664.   end;
  665.   
  666.   
  667. {-----------------------------------------------------}
  668. procedure TylThickThinSpline (* thetype : SplineKind; isclosed : boolean;
  669.               var KnotArray: ControlPoints; 
  670.               var ThikThinAry: ThickAryType;
  671.               numknots: integer;
  672.               vec: VectKind;
  673.               patt : LineStyle; domarks : integer *);
  674.   const NotAnArc = false;
  675.   begin 
  676.   layNspline (thetype, isclosed, NotAnArc, domarks, KnotArray, numknots, 
  677.         ThikThinAry, vec, patt);
  678.   end;
  679.   
  680. {----------------------------------------------------}
  681. procedure TylSpline (* thetype : SplineKind; isclosed : boolean;
  682.          var KnotArray: ControlPoints; numknots: integer;
  683.          thick: VThickness; vec: VectKind; patt : LineStyle; domarks : integer*);
  684.   const NotAnArc = false;
  685.   begin
  686.    layAspline (thetype, isclosed, NotAnArc, domarks, KnotArray, numknots, 
  687.         thick, vec, patt);
  688.   end;
  689.   
  690. {-----------------------------------------------------}
  691. procedure TylTieSlur (* KnotArray: ControlPoints; 
  692.               numknots: integer;
  693.               minthick, maxthick: VThickness *);
  694.   const ItsASlur = true;
  695.       NotClosed = false;
  696.   var ourttarray : ThickAryType;
  697.     one7th : real;
  698.     val : VThickness;
  699.   begin
  700.   
  701.   clampthickness (minthick);
  702.   clampthickness (maxthick);
  703.   if (numknots <> 5) then
  704.       writeln ('TieSlur needs 5 control points ');
  705.   one7th := 1.0/7.0;
  706.   val := round (one7th * (maxthick - minthick));
  707.   ourttarray[1] := minthick;
  708.   ourttarray[2] := minthick + val;
  709.   ourttarray[3] := maxthick;
  710.   ourttarray[4] := minthick + val;    
  711.   ourttarray[5] := minthick;
  712.   
  713.   layNspline (CATROM, NotClosed, ItsASlur, 0, KnotArray, numknots, ourttarray, 
  714.           VKCirc, solid);
  715.   end;
  716.   
  717.   
  718. {-------------------------------------------------------}
  719. procedure doTylArc (* iscircle : boolean;
  720.             var apts : ControlPoints;
  721.             numknots : integer; 
  722.             thick : VThickness; 
  723.             vec : VectKind;
  724.             patt : LineStyle *);
  725.   
  726.   const ItsAnArc = true;
  727.   begin
  728.   
  729.   layAspline (BSPL, iscircle, ItsAnArc, 0, apts, numknots, thick, vec, patt);
  730.   end;
  731.   
  732. {-----------------------------------------------------------}
  733. procedure TylArc (* radius : ScaledPts; centx, centy : ScaledPts;
  734.           firstangle, secondangle : integer;
  735.           thick : VThickness; vec : VectKind; patt : LineStyle *);
  736.   var apts : ControlPoints; 
  737.     numknots : integer;
  738.     iscircle : boolean;
  739.   begin
  740.   iscircle := (firstangle = secondangle);
  741.   if iscircle then
  742.     begin
  743.   {    maxspan := round ((360.0 / 16.0) * DEGTORAD * radius);
  744.   {}
  745.     defineCircleCpts (radius, centx, centy, apts, numknots);
  746.     end
  747.   else
  748.     begin
  749.   {    maxspan := round ((abs (secondangle - firstangle) / 16.0) * DEGTORAD * radius);
  750. { }
  751.   definearcpts (radius, centx, centy, 
  752.           firstangle, secondangle, apts, numknots);
  753.   end;
  754.  
  755.   doTylArc (iscircle, apts, numknots, thick, vec, patt); 
  756.  
  757.   end;
  758.   
  759. {-----------------------------------------------------------}
  760. procedure TylLabel (* xpos, ypos : ScaledPts;
  761.           fontstyle : integer;
  762.           phrase : charstring;
  763.           phraselen : integer *); 
  764. var findex : integer;
  765.   c : integer;
  766.   spaceover : integer;
  767.   
  768. begin
  769. if ((fontstyle < 1) or (fontstyle > MAXLABELFONTS)) then
  770.   begin
  771.   complain (ERRREALBAD);
  772.   writeln(logfile,'Unexpected bad fontstyle in TylLabel: ',fontstyle:0,'?');
  773.   jumpout;
  774.   end;
  775. findex := GetLabFont (fontstyle);
  776. isetpos (xpos, ypos);
  777. IPUSH;
  778. isetfont (LFontTable[findex]^.DVIFontNum);
  779. spaceover := LFontTable[findex]^.spacewidth;
  780. for c := 1 to phraselen do
  781.   begin
  782.   if (phrase[c] <> xchr[32]) then
  783.     begin
  784.     cmd1byte (SET1);
  785.     cmd1byte (xord[ phrase[ c ]]);
  786.     end
  787.   else
  788.     begin (* move over *)
  789.     cmd1byte (RIGHTLEFT + 2); (* assume distance is less than 3 bytes *)
  790.     cmdSigned (spaceover, 3);
  791.     end;
  792.   end;
  793. IPOP;
  794. end;
  795.  
  796.   
  797. (*  && start dvidvi section *)
  798. {-----------------------------------------------------}
  799. procedure initialize;
  800.   var
  801.       i: integer;
  802.   begin
  803.       for i := 0 to 31 do 
  804.       xchr[i] := '?';
  805.       xchr[32] := ' ';
  806.       xchr[33] := '!';
  807.       xchr[34] := '"';
  808.       xchr[35] := '#';
  809.       xchr[36] := '$';
  810.       xchr[37] := '%';
  811.       xchr[38] := '&';
  812.       xchr[39] := '''';
  813.       xchr[40] := '(';
  814.       xchr[41] := ')';
  815.       xchr[42] := '*';
  816.       xchr[43] := '+';
  817.       xchr[44] := ',';
  818.       xchr[45] := '-';
  819.       xchr[46] := '.';
  820.       xchr[47] := '/';
  821.       xchr[48] := '0';
  822.       xchr[49] := '1';
  823.       xchr[50] := '2';
  824.       xchr[51] := '3';
  825.       xchr[52] := '4';
  826.       xchr[53] := '5';
  827.       xchr[54] := '6';
  828.       xchr[55] := '7';
  829.       xchr[56] := '8';
  830.       xchr[57] := '9';
  831.       xchr[58] := ':';
  832.       xchr[59] := ';';
  833.       xchr[60] := '<';
  834.       xchr[61] := '=';
  835.       xchr[62] := '>';
  836.       xchr[63] := '?';
  837.       xchr[64] := '@';
  838.       xchr[65] := 'A';
  839.       xchr[66] := 'B';
  840.       xchr[67] := 'C';
  841.       xchr[68] := 'D';
  842.       xchr[69] := 'E';
  843.       xchr[70] := 'F';
  844.       xchr[71] := 'G';
  845.       xchr[72] := 'H';
  846.       xchr[73] := 'I';
  847.       xchr[74] := 'J';
  848.       xchr[75] := 'K';
  849.       xchr[76] := 'L';
  850.       xchr[77] := 'M';
  851.       xchr[78] := 'N';
  852.       xchr[79] := 'O';
  853.       xchr[80] := 'P';
  854.       xchr[81] := 'Q';
  855.       xchr[82] := 'R';
  856.       xchr[83] := 'S';
  857.       xchr[84] := 'T';
  858.       xchr[85] := 'U';
  859.       xchr[86] := 'V';
  860.       xchr[87] := 'W';
  861.       xchr[88] := 'X';
  862.       xchr[89] := 'Y';
  863.       xchr[90] := 'Z';
  864.       xchr[91] := '[';
  865.       xchr[92] := '\';
  866.       xchr[93] := ']';
  867.       xchr[94] := '^';
  868.       xchr[95] := '_';
  869.       xchr[96] := '`';
  870.       xchr[97] := 'a';
  871.       xchr[98] := 'b';
  872.       xchr[99] := 'c';
  873.       xchr[100] := 'd';
  874.       xchr[101] := 'e';
  875.       xchr[102] := 'f';
  876.       xchr[103] := 'g';
  877.       xchr[104] := 'h';
  878.       xchr[105] := 'i';
  879.       xchr[106] := 'j';
  880.       xchr[107] := 'k';
  881.       xchr[108] := 'l';
  882.       xchr[109] := 'm';
  883.       xchr[110] := 'n';
  884.       xchr[111] := 'o';
  885.       xchr[112] := 'p';
  886.       xchr[113] := 'q';
  887.       xchr[114] := 'r';
  888.       xchr[115] := 's';
  889.       xchr[116] := 't';
  890.       xchr[117] := 'u';
  891.       xchr[118] := 'v';
  892.       xchr[119] := 'w';
  893.       xchr[120] := 'x';
  894.       xchr[121] := 'y';
  895.       xchr[122] := 'z';
  896.       xchr[123] := '{';
  897.       xchr[124] := '|';
  898.       xchr[125] := '}';
  899.       xchr[126] := '~';
  900.       for i := 127 to 255 do 
  901.       xchr[i] := '?'; 
  902.       for i := 0 to 127 do 
  903.       xord[chr(i)] := 32;
  904.       for i := 32 to 126 do 
  905.       xord[xchr[i]] := i; 
  906.       initallspline;
  907.       initVnMnLtables;
  908.       multifigure := 0;
  909.       pgfigurenum := 0;
  910.       TotBytesWritten := 0;
  911.       ourq := 0;
  912.       specstart := 0; 
  913.       currpagenum := 0;
  914.       newbackptr := (-1);
  915.       oldbackptr := (-1);
  916.       ourfontnum := (-1);  (* undefined *)
  917.       origTexfont := (-1);
  918.       ourpushdepth := 0;
  919.       FTBDs := 0;
  920.       InitDVIBuf;
  921.       nf := 0;
  922.       inpostamble := false; 
  923.       didnewfonts := false;
  924.       maxpages := 10000;
  925.       sysdependent;
  926.       s := 0;         
  927.       skiptsclamp := false;
  928.       ErrorOccurred := false;
  929.     end; 
  930.  
  931.  
  932.  
  933. procedure inputln (var buffer : strng);
  934. var
  935.     k: 0..ARRLIMIT;
  936. begin
  937.  
  938.     flush(output);
  939.  
  940.     if eoln(input) then
  941.     readln(input);
  942.     k := 1;
  943.     while (k < ARRLIMIT) and (not eoln(input)) do 
  944.       begin
  945.     buffer.str[k] := input^;
  946.     k := k + 1;
  947.     get(input)
  948.       end;
  949.     buffer.str[k] := ' ';
  950.     buffer.len := k - 1;
  951. end;
  952.  
  953. function revindex (st : strng; let : char) : integer;
  954. label 2;
  955. var posit,i : integer;
  956. begin
  957.   posit := 0;
  958.   for i := st.len downto 1 do
  959.     begin
  960.     if (st.str[i] = let) then
  961.       begin
  962.       posit := i;
  963.       goto 2;
  964.       end;  
  965.     end; 
  966. 2:
  967.    revindex := posit;
  968. end;
  969.  
  970.  
  971. procedure stripblanks (var st : strng);
  972. var i,j,k: integer;
  973.   temp : charstring;
  974.   begin
  975.   j := 1;
  976.   i := 1;
  977.   while ((i <= st.len) and 
  978.      ((st.str[i] = ' ') or (st.str[i] = xchr[HT]))) do
  979.     begin
  980.     j := j + 1;
  981.     i := i + 1;
  982.     end;
  983.  
  984. (* j now points to the first non-blank character in st.str *)
  985.   i := 1;
  986.   for k := j to st.len do
  987.     begin
  988.     if ((st.str[k] <> ' ') and (st.str[k] <> xchr[HT])) then
  989.       begin
  990.       temp[i] := st.str[k];
  991.       i := i + 1;
  992.       end;
  993.     end;
  994.    (* now copy it back *)
  995.    if (i <> 1) then
  996.      begin (* there was blankspace *)
  997.      for k := 1 to (i- 1) do
  998.        st.str[k] := temp[k];
  999.      st.len := i - 1;
  1000.  
  1001.      st.str[i] := chr(32); (* end of string *)
  1002.  
  1003.      end;
  1004.   end;  
  1005.  
  1006.  
  1007. {-----------------------------------------------------}
  1008. procedure AskandOpenFiles;
  1009. var isok : boolean;
  1010.     i : integer;  
  1011.     rp : integer;
  1012.     tempname : strng;
  1013. begin
  1014.    isok := false;
  1015.    while (not isok) do
  1016.      begin
  1017.      write (' DVI-input File Name: ');
  1018.      inputln (dvifname);
  1019.      stripblanks (dvifname);
  1020.  
  1021.      rp := revindex (dvifname, '.');
  1022.      if (rp = 0) then
  1023.        begin 
  1024.        (* add a ".dvi" extension *)
  1025.        i := dvifname.len;
  1026.        dvifname.str[i + 1] := '.';
  1027.        dvifname.str[i + 2] := 'd';
  1028.        dvifname.str[i + 3] := 'v';
  1029.        dvifname.str[i + 4] := 'i';
  1030.        dvifname.len := i + 4;
  1031.        end;
  1032.      if (not opendvifile) then
  1033.        begin
  1034.        isok := false;  (* it is empty *)
  1035.        writestrng(dvifname,false);
  1036.        writeln(': Empty File??  Try another name.');
  1037.        end
  1038.      else
  1039.        isok := true;
  1040.      end;  (* while *)
  1041.  
  1042.         (* and ask for the name of the output file               *)
  1043.     (* default it to be the same prefix, but with a ".tyl" suffix *)
  1044.      strcopy (dvifname.str, outname.str, dvifname.len);
  1045.      outname.len := dvifname.len;
  1046.      rp := revindex (outname, '.');
  1047.      i := rp - 1;
  1048.      outname.str[i + 1] := '.';
  1049.      outname.str[i + 2] := 't';
  1050.      outname.str[i + 3] := 'y';
  1051.      outname.str[i + 4] := 'l';
  1052.      outname.len := i + 4;
  1053.      
  1054.      writeln (' DVI-output File Name :');
  1055.      write('(different than input name)[default of ');
  1056.      writestrng (outname,false);
  1057.      write(']');
  1058.      inputln (tempname);
  1059.      if (tempname.len > 1) then
  1060.        begin    (* a filename was typed in *)
  1061.        
  1062.        strcopy (tempname.str, outname.str, tempname.len);
  1063.        end;
  1064.  
  1065.      openoutputfile;
  1066. E_O_F
  1067. else
  1068.   echo "will not over write ./src/textyl.pas.ag"
  1069. fi
  1070. chmod 644 ./src/textyl.pas.ag
  1071. if [ `wc -c ./src/textyl.pas.ag | awk '{printf $1}'` -ne 27504 ]
  1072. then
  1073. echo `wc -c ./src/textyl.pas.ag | awk '{print "Got " $1 ", Expected " 27504}'`
  1074. fi
  1075. if `test ! -s ./src/textyl.pas.af`
  1076. then
  1077. echo "writing ./src/textyl.pas.af"
  1078. cat > ./src/textyl.pas.af << 'E_O_F'
  1079.         procedure gettransforms (var sc1, sc2, r : real;
  1080.                                 var tr1, tr2 : integer);
  1081.         label 22;
  1082.         var i : integer;                                
  1083.             dun : boolean;
  1084.         begin
  1085.           sc1 := 1.0; sc2 := 1.0;
  1086.           tr1 := 0; tr2 := 0;
  1087.           r := 0.0;
  1088.           i := parsposit - 1;
  1089.           if (i < 1) then
  1090.             begin
  1091.             goto 22; (* exit with defaults *)
  1092.             end;
  1093.           dun := false;
  1094.           while ((i < parsmax) and not dun) do
  1095.             begin
  1096.             if (isaletter(parsearray[i])) then
  1097.               begin
  1098.               if ((parsearray[i] = xord['t']) or
  1099.                   (parsearray[i] = xord['T'])) then
  1100.                  begin
  1101.                  if (isdelimiter(parsearray[i+1]) and
  1102.              isdelimiter(parsearray[i-1])) then
  1103.                     begin        (* get transform parameters *)
  1104.                     sc1 := getnumber / 100.0;
  1105.                     sc2 := getnumber / 100.0;
  1106.                     tr1 := getnumber;
  1107.                     tr2 := getnumber;
  1108.                     r := float(getnumber); (* degrees about primitive center *)
  1109.             if (r < 0.0) then
  1110.               r := r + 360.0;
  1111.                     dun := true;
  1112.                     end;
  1113.                  end;
  1114.               end;
  1115.             i := i + 1;
  1116.             end; (* while *)
  1117. 22:
  1118.         end; (* gettransforms *)
  1119.  
  1120. {__________________________________________________________________}
  1121.         function findmarker (markset : charset) : integer;
  1122.         label 1111;
  1123.         var i, sym : integer;
  1124.            dun : boolean;
  1125.         begin
  1126.         i := parsposit - 1;
  1127.         sym := EMPTY;
  1128.         if (i < 1) then
  1129.           goto 1111;
  1130.         dun := false;
  1131.         while ((i < parsmax) and not dun) do
  1132.           begin
  1133.           if (isaletter(parsearray[i])) then
  1134.             begin
  1135.             if (xchr[ parsearray[i] ] in markset) then
  1136.                 begin
  1137.                 if (isdelimiter (parsearray[i+1]) and
  1138.             isdelimiter (parsearray[i-1])) then
  1139.                   begin
  1140.                   sym := xord[tolowercase(xchr[parsearray[i]])];
  1141.                   dun := true;
  1142.                   end;
  1143.                 end;
  1144.             end;  (* if a letter *)
  1145.           i := i + 1;
  1146.           end;  (* while *)
  1147. 1111:     findmarker := sym;
  1148.         end;
  1149.  
  1150.  
  1151.  
  1152.         function findscale : integer;
  1153.         begin
  1154.           findscale := findmarker(['s','S','p','P','m','M']);
  1155.         end;
  1156.  
  1157.         function findvectkind : integer;
  1158.         begin
  1159.           findvectkind := findmarker(['c','C','h','H','v','V']);
  1160.         end;  
  1161.     
  1162.     function findlinestyle : integer;
  1163.     begin
  1164.       findlinestyle := findmarker(['l','L']);
  1165.     end;
  1166.  
  1167.         function findbeamkind : integer;
  1168.         begin
  1169.           findbeamkind := findmarker(['r','R','g','G']);
  1170.         end;
  1171.  
  1172.         function findsplinekind : integer;
  1173.         begin
  1174.           findsplinekind := findmarker(['b','B','i','I','k','K','d','D']);
  1175.         end;
  1176.  
  1177.         function findsplclosure : integer;
  1178.         begin
  1179.           findsplclosure := findmarker(['o','O','u','U']);
  1180.         end;
  1181.  
  1182.         function findatsign : integer;
  1183.         begin
  1184.           findatsign := findmarker(['@']);
  1185.         end;
  1186.     
  1187.     function finddotmark : integer;
  1188.     begin
  1189.       finddotmark := findmarker(['x','X']);
  1190.     end;
  1191.     
  1192.     function findfigdimens : integer;
  1193.     begin
  1194.       findfigdimens := findmarker(['w','W']);
  1195.     end;  
  1196.     
  1197.     function findfitsizes : integer;
  1198.     begin
  1199.       findfitsizes := findmarker(['f','F']);
  1200.     end;
  1201.  
  1202.  
  1203.    {_________________________________________________}
  1204.    function thescaleof (scal : integer) : real;
  1205.    begin
  1206.     if (scal = xord['s']) then
  1207.      thescaleof := 1 * magfactor
  1208.     else if (scal = xord['p']) then
  1209.      thescaleof := SPPERPT * magfactor
  1210.     else if (scal = xord['m']) then
  1211.      thescaleof := SPPERMM * magfactor
  1212.     else if (scal = EMPTY) then
  1213.      thescaleof := SPPERPT * magfactor;
  1214.    end;
  1215.     
  1216.  
  1217.    function thevectorof (vkin : integer) : VectKind;
  1218.    begin
  1219.      if (vkin = xord['c']) then
  1220.        thevectorof := VKCirc
  1221.      else if (vkin = xord['v']) then
  1222.        thevectorof := VKVert
  1223.      else if (vkin = xord['h']) then
  1224.        thevectorof := VKHort
  1225.      else if (vkin = EMPTY) then
  1226.        thevectorof := VKCirc;
  1227.    end;
  1228.    
  1229.    function thestyleof (linest : integer) : LineStyle;
  1230.    begin
  1231.      if ((linest > 3) or 
  1232.          (linest < 0)) then linest := 0;
  1233.      case linest of
  1234.         0 : thestyleof := solid;
  1235.     1 : thestyleof := dotted;
  1236.     2 : thestyleof := dashed;
  1237.     3 : thestyleof := dotdash;
  1238.      end;
  1239.    end;
  1240.  
  1241.       
  1242.  
  1243.  
  1244. (* -----!!!!!!!!!!!!  HandleSpecials !!!!!!!!!!!!!------ *)
  1245. begin 
  1246.   tylnam     := 'tyl';
  1247.   beginfigurenam := 'beginfigure';
  1248.   endfigurenam     := 'endfigure';
  1249.   linenam     := 'line';
  1250.   splinenam     := 'spline';
  1251.   ttsplnam     := 'ttspline';
  1252.   beamnam     := 'beam';
  1253.   tieslurnam     := 'tieslur';
  1254.   arcnam     := 'arc';
  1255.   labelnam     := 'label';
  1256.   paramnam     := 'param';
  1257.   usingstream     := true; (* getting bytes from dvifile *)
  1258.  
  1259.   specstart := DVIMark - (specnum - 239 + 1) - 1;
  1260.  
  1261.   ourxpos := h; ourypos := v;  (* note the global DVI (h,v) coords *)
  1262.   i := 1;
  1263.  
  1264.   b := Dget1byte; (* prime the reading scheme *)
  1265.   gotten := (specnum - 239 + 1);
  1266.  
  1267.   while (isaspace(b)) do
  1268.     b := nextpbyte;
  1269.  
  1270.   let := getletter;
  1271.   while (let <> ' ') do (* get the name of the system --- Hopefully 'tyl' *)
  1272.     begin
  1273.     sysnam.str[i] := tolowercase(let);
  1274.     sysnam.len := i;
  1275.     i := i + 1;
  1276.     let := getletter;
  1277.     end;
  1278.  
  1279.    sysnam.str[i] := chr(32); (* end of string *)  
  1280.  
  1281.   if (not streq (sysnam.str, tylnam, 3)) then   (* TeXtyl doesnt know about this special *)
  1282.     begin
  1283.     write (logfile,'The special: ');
  1284.     writestrng(sysnam,true);
  1285.     writeln(logfile,'    is not tyl-able. Skipping...');
  1286.     while (gotten < numpbytes) do
  1287.       b := nextpbyte;
  1288.     goto 888;
  1289.     end;
  1290.  
  1291. (* OTHERWISE: all is okay. Lets look for a primitive to tyl *)
  1292.  
  1293.   while (isdelimiter(b)) do
  1294.     begin
  1295.       b := nextpbyte;
  1296.     end;
  1297.   i := 1;
  1298.   let := getletter; {xchr[b];}
  1299.   while (not (isdelimiter(xord[let]))) do (* get the name of the primitive *)
  1300.     begin
  1301.     nam.str[i] := tolowercase(let);
  1302.     nam.len := i;
  1303.     i := i + 1;
  1304.     let := getletter;
  1305.     end;
  1306.  
  1307.    nam.str[i] := chr(32); (* end of string *)  
  1308.  
  1309.  
  1310.   let := xchr[b];
  1311.  
  1312. (* Now, fill the parse array with bytes so that we can get
  1313.    the given parameters, and infer the defaulted params *)
  1314.  
  1315.   parsmax := min (PARSLEN, ((numpbytes - gotten) + 1));
  1316.  
  1317.   if (parsmax > 1) then
  1318.     begin
  1319.     parsearray[1] := xord[' ']; (* we need this *)
  1320.     parsearray[2] := b;     (* start filling *)
  1321.     for i := 3 to parsmax do
  1322.        begin        (* fill rest *)
  1323.        parsearray[i] := nextpbyte;
  1324.        end;
  1325.     parsposit := 1;
  1326.     usingstream := false; (* now we look at bytes in parse array *)  
  1327.     b := nextpbyte;       (* start it *)
  1328.     end
  1329.   else
  1330.     begin
  1331.     usingstream := true;
  1332.     parsposit := -1; (* undefined *)
  1333.     end;
  1334.  
  1335.                 (* --- BEGINFIGURE ---- *)
  1336.   if streq(nam.str, beginfigurenam, 3) then 
  1337.     begin
  1338.     multifigure := multifigure + 1;
  1339.     i := findscale;
  1340.     SPscale := thescaleof (i);
  1341.  
  1342.     gettransforms (sx100, sy100, rot, transx, transy);
  1343.     (* store all the primitives on pageitems, and dont output
  1344.         them until we get a endfigure. this way, we can take
  1345.         care of dealing with all the primitives according to
  1346.         some global tranformation for the whole figure *)
  1347.       pi := NewItem (Afigure);
  1348.       with pi^ do
  1349.         begin
  1350.         figtheta := rot;
  1351.         fsx := sx100;   fsy := sy100;
  1352.         fdx := round (transx * SPscale);  
  1353.         fdy := round (transy * SPscale);
  1354.         depthnumber := multifigure; (* we're at a new level *)
  1355.     i := findfigdimens;
  1356.     if (i <> EMPTY) then
  1357.       begin
  1358.       preWid := round (getnumber * SPscale);
  1359.       preHt := round (getnumber * SPscale);
  1360.       end;
  1361.     i := findfitsizes;
  1362.     if (i <> EMPTY) then
  1363.       begin
  1364.       postWid := round (getnumber * SPscale);
  1365.       postHt := round (getnumber * SPscale);
  1366.       end;
  1367.         end;  (* with *)
  1368.       BackupInBuf (DVIMark - specstart);
  1369.       pushItem (multifigure - 1, pi);
  1370.       goto 888;
  1371.     end;
  1372.                 (* ---- ENDFIGURE ---- *)
  1373.   if streq(nam.str, endfigurenam, 3) then
  1374.     begin
  1375.     multifigure := multifigure - 1;
  1376.     if (multifigure < 0) then
  1377.       begin
  1378.       complain (ERRBAD);
  1379.       write(logfile,'Warning: Too many "endfigure"s !');
  1380.       multifigure := 0;
  1381.       end;
  1382.     BackupInBuf (DVIMark - specstart);
  1383.  
  1384.     if (multifigure = 0) then
  1385.       begin
  1386.          (* go do our set of figures (within figures...) *)
  1387.       figurehandle (pageitems, pageitems, 1);
  1388.       dispose (pageitems);      (* ### should maybe garbage collect here *)
  1389.       pageitems := nil; 
  1390.       end;  (* if *)
  1391.     goto 888;
  1392.     end;
  1393.  
  1394.                 (* --- LINE  --- *)
  1395.    if streq(nam.str, linenam, 3) then
  1396.      begin              
  1397.      i := findscale;
  1398.      SPscale := thescaleof(i);
  1399.  
  1400.      gettransforms (sx100, sy100, rot, transx, transy);
  1401.      thk := getnumber; (* get the vector thickness *)
  1402.      if (thk < 1) then
  1403.        begin
  1404.        complain (ERRBAD);
  1405.        writeln(logfile,'?? Thickness not found. Setting to 1');
  1406.        thk := 1;
  1407.        end;
  1408.      i := findvectkind;
  1409.      vk := thevectorof (i);
  1410.  
  1411.      i := findlinestyle;
  1412.      if (i <> EMPTY) then
  1413.        patt := thestyleof (getnumber)
  1414.      else
  1415.        patt := solid;
  1416.           
  1417.      x1 := round (getnumber * SPscale);
  1418.      y1 := round (getnumber * SPscale);
  1419.      x2 := round (getnumber * SPscale);
  1420.      y2 := round (getnumber * SPscale);
  1421.  
  1422.      minx := min (x1, x2);
  1423.      maxx := max (x1, x2);
  1424.      miny := min (y1, y2);
  1425.      maxy := max (y1, y2);
  1426.   
  1427.      BackupInBuf (DVIMark - (specstart)); 
  1428.      cmd1byte (OURFONTFLAG);
  1429.      linehandle (multifigure, SPscale, x1, y1, x2, y2, 0, 0, thk, vk, patt,
  1430.                  minx, maxx, miny, maxy,
  1431.                         transx, transy, sx100, sy100, rot);
  1432.    end (* line *)
  1433.                 (* ---- THE SPLINES ---- *)
  1434. else if (streq(nam.str, splinenam, 3) or
  1435.          streq(nam.str, ttsplnam,3)) then
  1436.    begin
  1437.     i := findscale;
  1438.     SPscale := thescaleof (i);
  1439.  
  1440.    gettransforms (sx100, sy100, rot, transx, transy);
  1441.    
  1442.    if streq(nam.str, splinenam, 3) then
  1443.      begin
  1444.      thk := getnumber;
  1445.      if (thk < 1) then
  1446.        begin
  1447.        complain (ERRBAD);
  1448.        writeln(logfile,'Spline Thickness not found. Setting to 1');
  1449.        thk := 1;
  1450.        end;     
  1451.      end;
  1452.      i := findvectkind;
  1453.      vk := thevectorof (i);
  1454.  
  1455.      i := findlinestyle;
  1456.      if (i <> EMPTY) then
  1457.        patt := thestyleof (getnumber)
  1458.      else
  1459.        patt := solid;
  1460.  
  1461.      i := findsplinekind;
  1462.      if (i = xord['b']) then
  1463.        splinetype := BSPL
  1464.      else if (i = xord['i']) then
  1465.        splinetype := INTBSPL
  1466.      else if (i = xord['k']) then
  1467.        splinetype := CATROM
  1468.      else if (i = xord['d']) then
  1469.        splinetype := CARD
  1470.      else if (i = EMPTY) then
  1471.        splinetype := CATROM;
  1472.        
  1473.      i := findsplclosure;
  1474.      if (i = xord['o']) then
  1475.        isclosedspline := true
  1476.      else if (i = xord['u']) then
  1477.        isclosedspline := false
  1478.      else if (i = EMPTY) then
  1479.        isclosedspline := false;
  1480.  
  1481.      i := finddotmark;
  1482.      if (i = xord['x']) then
  1483.        markdiam := getnumber
  1484.      else if (i = EMPTY) then
  1485.        markdiam := 0;
  1486.             
  1487.    numknots := min (getnumber, MAXCTLPTS);
  1488.    if (numknots < 1) then
  1489.      begin
  1490.      complain (ERRBAD);
  1491.      writeln(logfile,'Number of spline/ttspline knot points not found. Setting to 1');
  1492.      numknots := 1;
  1493.      end;
  1494.  
  1495.    minx := TWO24; miny := TWO24;
  1496.    maxx := -TWO24; maxy := -TWO24;
  1497.    
  1498.    for i := 0 to (numknots + 3) do
  1499.      begin
  1500.      cpts[i,1] := 0;
  1501.      cpts[i,2] := 0;
  1502.      end;  (* for *)
  1503.  
  1504.    for i := 1 to numknots do
  1505.      begin
  1506.      x1 := round (getnumber * SPscale);
  1507.      cpts[i,1] := x1;
  1508.      if (x1 < minx) then
  1509.        minx := x1;
  1510.      if (x1 > maxx) then
  1511.        maxx := x1;
  1512.      y1 := round (getnumber * SPscale);
  1513.      cpts[i,2] := y1;
  1514.      if (y1 < miny) then
  1515.        miny := y1;
  1516.      if (y1 > maxy) then
  1517.        maxy := y1;
  1518.      end; (* for *)
  1519.  
  1520.    if streq(nam.str, ttsplnam, 3) then
  1521.      begin
  1522.      for i := 1 to numknots do
  1523.        begin
  1524.        TTary[i] := getnumber;
  1525.        end;
  1526.      end;
  1527.  
  1528.    BackupInBuf (DVIMark - (specstart));
  1529.    cmd1byte (OURFONTFLAG);
  1530.  
  1531.    if streq(nam.str, splinenam, 3) then
  1532.      splinehandle (multifigure, SPscale, splinetype, isclosedspline,
  1533.            markdiam, cpts, numknots, 
  1534.                    0, 0, thk, vk, patt, minx, maxx, miny, maxy, 
  1535.                    transx, transy, sx100, sy100, rot)
  1536.    else
  1537.      ttsplhandle (multifigure, SPscale, splinetype, isclosedspline,
  1538.            markdiam, cpts, TTary, numknots, 
  1539.                    0, 0, vk, patt, minx, maxx, miny, maxy, 
  1540.                    transx, transy, sx100, sy100, rot);
  1541.    end (* splines *)
  1542.                 (* --- BEAMS ---- *)
  1543.  else if streq(nam.str, beamnam, 4) then
  1544.     begin
  1545.     i := findscale;
  1546.     SPscale := thescaleof (i);
  1547.     
  1548.     (* no transforms *)
  1549.  
  1550.     siz := getnumber; (* the staffsize *)
  1551.     i := findbeamkind;
  1552.     if (i = xord['g']) then
  1553.       bk := grace
  1554.     else if (i = xord['r']) then
  1555.       bk := regular
  1556.     else if (i = EMPTY) then
  1557.       bk := regular;
  1558.  
  1559.     x1 := round (getnumber * SPscale);  
  1560.     y1 := round (getnumber * SPscale);
  1561.     x2 := round (getnumber * SPscale);
  1562.     y2 := round (getnumber * SPscale);
  1563.  
  1564.     BackupInBuf (DVIMark - (specstart));
  1565.     cmd1byte (OURFONTFLAG);
  1566.  
  1567.     beamhandle (multifigure, siz, bk, x1, y1, x2, y2);
  1568.     end (* beam *)
  1569.                 (* ---- TIES AND SLURS ---- *)
  1570.   else if streq(nam.str, tieslurnam, 3) then
  1571.     begin
  1572.     i := findscale;
  1573.     SPscale := thescaleof (i);
  1574.  
  1575.      minthk := getnumber;
  1576.      if (minthk < 1) then
  1577.        begin
  1578.        complain (ERRBAD);
  1579.        writeln(logfile,'Tie/Slur Min Thickness not found. Setting to 1');
  1580.        minthk := 1;
  1581.        end;
  1582.    
  1583.      maxthk := getnumber;
  1584.      if (maxthk < 1) then
  1585.        begin
  1586.        complain (ERRBAD);
  1587.        writeln(logfile,'Tie/Slur MaxThickness not found. Setting to 1');
  1588.        maxthk := 1;
  1589.        end;
  1590.  
  1591.      numknots := min (getnumber, MAXCTLPTS);
  1592.      if (numknots < 1) then
  1593.        begin
  1594.        complain (ERRBAD);
  1595.        writeln(logfile,'Tie/Slur Number of knot points not found. Setting to 1. Should be 5');
  1596.        numknots := 1;
  1597.        end;
  1598.      for i := 1 to numknots do
  1599.        begin
  1600.        cpts[i,1] := round (getnumber * SPscale);
  1601.        cpts[i,2] := round (getnumber * SPscale);
  1602.        end;  (* for *)
  1603.     BackupInBuf (DVIMark - (specstart));
  1604.     cmd1byte (OURFONTFLAG);
  1605.  
  1606.     tieslurhandle (multifigure, cpts, numknots, minthk, maxthk);     
  1607.     end (* ties and slurs *)
  1608.     (* --------- ARCS and CIRCLES --------- *)
  1609.   else if streq (nam.str, arcnam, 3) then
  1610.     begin
  1611.     i := findscale;
  1612.     SPscale := thescaleof (i);
  1613.  
  1614.    gettransforms (sx100, sy100, rot, transx, transy);
  1615.    
  1616.    thk := getnumber;
  1617.    if (thk < 1) then
  1618.      begin
  1619.      complain (ERRBAD);
  1620.      writeln(logfile,'Arc Thickness not found. Setting to 1');
  1621.      thk := 1;
  1622.      end;     
  1623.    i := findvectkind;
  1624.    vk := thevectorof (i);
  1625.  
  1626.    i := findlinestyle;
  1627.    if (i <> EMPTY) then
  1628.      patt := thestyleof (getnumber)
  1629.    else
  1630.      patt := solid;
  1631.   
  1632.    radius := round (getnumber * SPscale);
  1633.    if (radius = 0) then
  1634.      radius := round(1 * SPscale);
  1635.    i := findatsign;
  1636.    if (i <> EMPTY) then
  1637.      begin
  1638.      x2 := round (getnumber * SPscale);
  1639.      y2 := round (getnumber * SPscale);
  1640.      end
  1641.    else
  1642.      begin
  1643.      x2 := 0; y2 := 0;  (* assume center at origin *)
  1644.      end; 
  1645.   
  1646.    ang1 := getnumber;
  1647.    if (abs(ang1) > 360) then
  1648.      ang1 := ang1 mod 360;
  1649.    ang2 := getnumber;
  1650.    if (abs(ang2) > 360) then
  1651.      ang2 := ang2 mod 360;
  1652.   
  1653.    minx := TWO24; miny := TWO24;
  1654.    maxx := -TWO24; maxy := -TWO24;
  1655.    
  1656.    if (ang1 = ang2) then
  1657.      begin     (* a circle *)
  1658.        defineCircleCpts (radius,x2,y2, cpts, numknots);
  1659.      end
  1660.    else
  1661.      begin      (* a real arc *)
  1662.      definearcpts (radius, x2,y2, ang1, ang2, cpts, numknots);
  1663.      end;
  1664.   
  1665.    for i := 1 to numknots do
  1666.      begin
  1667.      x1 := cpts[i,1];
  1668.      if (x1 < minx) then
  1669.        minx := x1;
  1670.      if (x1 > maxx) then
  1671.        maxx := x1;
  1672.   
  1673.      y1 := cpts[i,2];
  1674.      if (y1 < miny) then
  1675.        miny := y1;
  1676.      if (y1 > maxy) then
  1677.        maxy := y1;
  1678.      end; (* for *)
  1679.   
  1680.    BackupInBuf (DVIMark - (specstart));
  1681.    cmd1byte (OURFONTFLAG);
  1682.   
  1683.    arccirclehandle (multifigure, SPscale, x2, y2, 
  1684.            radius, ang1, ang2,
  1685.            cpts, numknots, 
  1686.            0, 0, thk, vk, patt, minx, maxx, miny, maxy, 
  1687.            transx, transy, sx100, sy100, rot)
  1688.   
  1689.     end (* arc and circle *)
  1690.     (* ---------- LABELS --------------*)
  1691.   else if streq (nam.str, labelnam, 3) then
  1692.     begin
  1693.     i := findscale;
  1694.     SPscale := thescaleof (i);
  1695.   
  1696.     style := getnumber; (* font style number *)
  1697.     if ((style < 1) or (style > MAXLABELFONTS)) then
  1698.       begin
  1699.       complain (ERRBAD);
  1700.       writeln(logfile,'Label style bad? Setting to Style 1');
  1701.       style := 1;
  1702.       end;
  1703.   
  1704.     x1 := round (getnumber * SPscale);
  1705.     y1 := round (getnumber * SPscale);
  1706.     
  1707.     let := getletter;
  1708.     while (let <> '"') do
  1709.       begin
  1710.       let := getletter;
  1711.       end;
  1712.     i := 0;
  1713.     let := getanything; (* get next letter or whatever *)  
  1714.     while (let <> '"') do
  1715.       begin        (* get the label phrase *)
  1716.       i := i + 1;
  1717.       phrase.str[i] := let;
  1718.       let := getanything; (* getletter;*)
  1719.       end;
  1720.  
  1721.     phrase.str[i+1] := chr(32);
  1722.  
  1723.     phrase.len := i;
  1724.   
  1725.     BackupInBuf (DVIMark - specstart);
  1726.     cmd1byte (OURFONTFLAG);
  1727.     labelhandle (multifigure, SPscale, x1, y1, 0, 0, style, phrase, 0, 0);
  1728.     end (* label *)
  1729.  
  1730.     (* --------- INTERNAL PARAM -------*)
  1731.   else if streq (nam.str, paramnam, 3) then
  1732.     begin
  1733.     i := getnumber; (* addressable param number *)
  1734.  
  1735.       begin
  1736.       writeln (logfile,' I do not know what internal parameter #',i:0,' is');
  1737.       end;  (* else *)
  1738.     BackupInBuf (DVIMark - (specstart));
  1739.     end (* Internal param *)
  1740.   
  1741.       (* ==============  NONE OF THE ABOVE ============== *)
  1742.   else
  1743.     begin       
  1744.     complain (ERRNOTBAD);
  1745.     write (logfile,'Sorry, I don''t know how to tyl ');
  1746.     writestrng (nam,true);
  1747.       
  1748.     while (gotten < numpbytes) do
  1749.       begin
  1750.       b := nextpbyte;
  1751.       end;
  1752.     end;
  1753.   888:
  1754.       (* make sure that we used up all the bytes in this special *)
  1755.   if (gotten < numpbytes) then
  1756.     begin
  1757.     while (gotten < numpbytes) do
  1758.       begin              (* slurp  up  excess *)
  1759.       b := Dgrabbyte;
  1760.       gotten := gotten + 1;
  1761.       end;
  1762.     end;  (* if *)
  1763.   end; (* mainhandlespecials *)
  1764.   
  1765.   
  1766.   (* ==================================================
  1767.   
  1768.   The routines below assume coordinates are already in
  1769.     4th Quadrant DVI-space
  1770.   
  1771.   =====================================================*)
  1772.   
  1773.   
  1774.   
  1775.   {-----------------------------------------------------}
  1776.   (* returns 0 if dy.dx not in font
  1777.       1 if ok
  1778.       2 if ok and caller should use two of the "code"s
  1779.      coding scheme requires  0<= [dx, dy] <= 16
  1780.      AND that max(dx, abs(dy)) is in [0,1,2,4,8,16]
  1781.   *)
  1782. function outvector (dx, dy : integer; var code : integer) : integer;
  1783.   label 99;
  1784.   var c : integer;
  1785.       result : integer;
  1786.   begin
  1787.     if (dx < 0) then
  1788.       begin
  1789.       outvector := 0;
  1790.       goto 99;
  1791.       end;
  1792.       
  1793.     result := 0; (* init for potential failure *)
  1794.     code := (-1);
  1795.     if (dy < 0) then
  1796.       begin
  1797.       c := 160 + dy + dx - 9*max (dx, -dy);
  1798.       end
  1799.     else
  1800.       begin
  1801.       c := 160 + dy - dx - 7*max (dx, dy);
  1802.       end;
  1803.   
  1804.     (* here translate to OUR coding scheme 
  1805.      and return the correct number
  1806.        this is needed because "c" thinks the char range
  1807.        is 0 to 160, while we have only 128 chars *)
  1808.   
  1809.      if (c = 0) then       (* special cases *)
  1810.        begin
  1811.        code := 63; 
  1812.        result := 2;
  1813.        end
  1814.      else if (c = 64) then
  1815.        begin
  1816.        code := 95;
  1817.        result := 2;
  1818.        end
  1819.      else
  1820.        begin       (* regular ones *)
  1821.        result := 1;  (* just one char is fine *)
  1822.        if (c in [1..63]) then
  1823.      code := c - 1
  1824.        else if (c in [80..112]) then
  1825.      code := c - 17
  1826.        else if (c in [120..136]) then
  1827.      code := c - 24
  1828.        else if (c in [140..148]) then
  1829.      code := c - 27
  1830.        else if (c in [150..154]) then
  1831.      code := c - 28
  1832.        else if (c = 160) then
  1833.      code := 127; (* c - 33 *)
  1834.        end;
  1835.   99:
  1836.    outvector := result;
  1837.   end;
  1838.   
  1839.   
  1840.   
  1841.   (* take care of a Manhattan (horizontal /vertical) line *)
  1842.   {----------------------------------------------------------} 
  1843. procedure hvline (lx, by, rx, ty, fontindex : integer);
  1844.   var t, rth, x, y, width, height : integer;
  1845.   begin
  1846.   rth := VFontTable[fontindex]^.PenSize; (* thickness of vector in sp *)
  1847.   if (lx = rx) then
  1848.     begin              (* Vertical line *)
  1849.     if (ty > by) then       
  1850.       begin
  1851.       t := by; by := ty; ty := t;  (* swap *)
  1852.       end;
  1853.     x := round (lx - (rth / 2.0));
  1854.     y := by;
  1855.     width := rth;
  1856.     height := by - ty;
  1857.     end
  1858.   else
  1859.     begin              (* Horizontal line *)
  1860.     if (ty < by) then
  1861.       begin
  1862.       t := by; by := ty; ty := t;  (* swap *)
  1863.       end;
  1864.     if (lx > rx) then
  1865.       begin
  1866.       t := lx; lx := rx; rx := t; (* swap *)
  1867.       end;
  1868.     x := lx;
  1869.   
  1870.     y := (by + (rth div 2)); (* + rth for {h,v}-space *)
  1871.     width := rx - lx;
  1872.     height := rth;
  1873.     end;
  1874.   
  1875.   isetpos (x, y);
  1876.   cmd1byte (PUTRULE);
  1877.   cmd4byte (height);
  1878.   cmd4byte (width);
  1879.   
  1880.   (* output two dots on ends of the rules
  1881.    at    lx, by  and rx, ty  *)
  1882.   (* the font has already been set before these calls *)
  1883.   Tyldot (lx, by);
  1884.   Tyldot (rx, ty);
  1885.   isetpos (rx, ty);
  1886.   end;
  1887.   
  1888.   
  1889.   {------------------------------------------------------------}
  1890. procedure diagonal (xl, yb, xr, yt : ScaledPts; fontindex: integer);
  1891.   var t, curx, cury, dx, dy, code : integer;
  1892.       slope : real;
  1893.       mxveclen : ScaledPts;
  1894.       sptovecs : real;
  1895.       rho : ScaledPts;
  1896.   
  1897.       {......................................}
  1898.       (* compute maximum length vector character that we  can use *)
  1899.   
  1900.       procedure  getincr (var outdx, outdy : integer);
  1901.       label 99;
  1902.        var radius, x, y : integer;
  1903.        sign : integer;
  1904.        q : real;
  1905.   
  1906.        begin  (* getincr *)
  1907.        radius := mxveclen;   (* radius of semi-square *)
  1908.        (* make sure the pt is outside of the semi-square,
  1909.       scaling down radius if necessary *)
  1910.        while ( ((xr - curx) < radius) and
  1911.           (abs (yt - cury) < radius)) do
  1912.      begin
  1913.      radius := radius div 2;
  1914.      end;
  1915.        if (slope < 0.0) then  (* <0 since in 4th quad by now*)
  1916.      sign := -1
  1917.        else
  1918.      sign := +1;
  1919.        if (xr = curx) then
  1920.      begin
  1921.      outdx := 0;
  1922.      outdy := sign * radius;
  1923.      goto 99;
  1924.      end;
  1925.        if (yt = cury) then
  1926.      begin
  1927.      outdx := abs (radius);
  1928.      outdy := 0;
  1929.      goto 99;
  1930.      end;
  1931.   
  1932.        (* compute the intersection with the semi-square,
  1933.       choose whichever slope is best *)
  1934.        if (abs (slope) < 1.0) then
  1935.      begin              (* mostly horizontal *)
  1936.      outdx := abs (radius);
  1937.      y := yb + round ((curx + abs(radius) - xl) * slope); 
  1938.      outdy := y - cury;
  1939.      end
  1940.        else
  1941.      begin              (* mostly vertical *)
  1942.      x := xl + round ((cury + (sign * radius) - yb) / slope); 
  1943.      outdx := x - curx;
  1944.      outdy := sign * radius;
  1945.      end;
  1946.   
  1947.        if (abs (outdy) > abs (yt - cury)) then
  1948.      begin         (* truncate *)
  1949.      outdy := yt - cury;
  1950.      end;
  1951.        if (outdx > (xr - curx)) then
  1952.      begin         (* truncate *)
  1953.      outdx := xr - curx;
  1954.      end;
  1955.        if (outdx < 0) then
  1956.      begin
  1957.      outdx := 0;
  1958.      end;
  1959.   
  1960.        (* method to find the exact intersection of the line segment
  1961.     with the semi-circle, used
  1962.     to determine the x and y values::
  1963.     we do this by using the arctangent of the slope as
  1964.     the angle 'a' from the x-axis. Then use the relation
  1965.      y = r cos a, and x = r sin a
  1966.     we can be smart about all this trig stuff by using
  1967.     the relation :
  1968.         sin (arctan a) = 1/sqrt(1 + a^2)
  1969.         cos (arctan a) = a/sqrt(1 + a^2)
  1970.     Thus:
  1971.     q := (1.0 / sqrt (slope * slope + 1.0));
  1972.     outdx := round (q * radius);
  1973.     outdy := round (q * radius * slope);
  1974.   
  1975.     Unfortunately, we cannot access the Vector Font
  1976.     coding scheme because the outdx, outdy 's produced
  1977.     here do no conform to the condition
  1978.         max (dx, abs(dy)) in [0,1,2,4,8,16]
  1979.     when converted to vector-font sizes with 
  1980.     sptovecs (see  the 'diagonal' proc.).
  1981.     *)
  1982.   
  1983.   99:
  1984.        end; (* getincr *)
  1985.     {.......................................}
  1986.   
  1987.   begin (* DIAGONAL *)
  1988.   if (xr <> xl) then
  1989.     slope := (yt - yb) / (xr - xl)
  1990.   else
  1991.     slope := BIGREAL; (* some illegal value *)
  1992.   
  1993.   if (xl > xr) then
  1994.     begin
  1995.     t := xl; xl := xr; xr := t;
  1996.     t := yb; yb := yt; yt := t;
  1997.     end; (* swap *)
  1998.     
  1999.   curx := xl;
  2000.   cury := yb;
  2001.   mxveclen :=  (VFontTable[fontindex]^.MaxVectLen); 
  2002.   rho := mxveclen div 16;  (* minimum radius of vector fonts *)
  2003.   if (rho = 0) then
  2004.     begin
  2005.     complain (ERRREALBAD);
  2006.     writeln(logfile,'Diagonal: Min radius of vector font is zero. setting to 1');
  2007.     rho := 1;
  2008.     end;
  2009.   
  2010.   if ((abs(xl - xr) <= rho) and
  2011.       (abs(yb - yt) <= rho)) then
  2012.     begin    (* pretty much a null line *)
  2013.       Tyldot (xl, yb);
  2014.     end
  2015.   else
  2016.     begin
  2017.     sptovecs := 1.0 / rho; (* conversion for scaled pts to vectorfont units *)
  2018.   
  2019.     code := -1; (* initialize to a bogus number *)
  2020.   
  2021.     (* this conditional really has to have "or"
  2022.         instead of "and", because of lines that are
  2023.         *nearly*  horizontal or vertical
  2024.     *)
  2025.     while (((xr - curx) >= rho) or (abs(yt - cury) >= rho)) do  
  2026.       begin
  2027.   (* Get the approximate incremental amount. We use this dy/dx
  2028.     pair in order to index into our vector font coding scheme *)
  2029.   
  2030.       getincr (dx, dy);
  2031.   
  2032.   (* Get the vector character code corresponding to this 
  2033.     approximate incremental amount *)
  2034.       t := outvector (round (dx * sptovecs), 
  2035.               round (dy * sptovecs), 
  2036.               code);
  2037.   (* Now that we have the character code, go find out its actual
  2038.     physical dimensions for the real dy/dx amounts *)
  2039.       if (dy > 0) then
  2040.      dy := VFontTable[fontindex]^.FontInfo[code].Cdp
  2041.       else
  2042.      dy := -(VFontTable[fontindex]^.FontInfo[code].Cht);
  2043.   
  2044.       dx := VFontTable[fontindex]^.FontInfo[code].Cwd;
  2045.     
  2046.       case (t) of
  2047.        0: begin
  2048.         complain (ERRREALBAD);
  2049.         writeln (logfile,'Error in Diagonal:: bad dydx');
  2050.       end;
  2051.       
  2052.        1: begin
  2053.         isetpos (curx, cury);
  2054.         iputchar (code);
  2055.       end;
  2056.           
  2057.        2: begin
  2058.         isetpos (curx, cury);
  2059.         iputchar (code);
  2060.         isetpos (curx + (dx div 2),  cury + (dy div 2));
  2061.         iputchar (code);
  2062.       end;
  2063.       end; (* case *)
  2064.   
  2065.       curx := curx + dx;
  2066.       cury := cury + dy;
  2067.       end; (* while *)
  2068.   
  2069.     if ((code >= 0) and
  2070.      (((xr - curx) >= rho) and (abs(yt - cury) >= rho))) then
  2071.       begin
  2072.       iputchar (code);
  2073.       end;
  2074.     end;   (* not null line *)
  2075.   end;
  2076.  
  2077.  
  2078. {-------------------------------------------------------}
  2079. E_O_F
  2080. else
  2081.   echo "will not over write ./src/textyl.pas.af"
  2082. fi
  2083. chmod 644 ./src/textyl.pas.af
  2084. if [ `wc -c ./src/textyl.pas.af | awk '{printf $1}'` -ne 26365 ]
  2085. then
  2086. echo `wc -c ./src/textyl.pas.af | awk '{print "Got " $1 ", Expected " 26365}'`
  2087. fi
  2088. echo "Finished archive 5 of 9"
  2089. exit
  2090.